unit sshprocs;

{$mode objfpc}
{$H+}

interface

uses
  classes, SysUtils, BaseUnix, common;
  
type
  
  TSystemAgent = class(TObject)
    private
      FList : TList;
      FSSH  : string;
      function Get(Index: Integer) : TProcessInfo;
      function GetCount : integer;
    public
      constructor Create;
      destructor  Destroy; override;
      procedure   Refresh;
      procedure   CreateTunnel(const TheInfo : TProcessInfo);
      procedure   RemoveTunnel(const TheInfo : TProcessInfo);
      property    Items[Index:integer] : TProcessInfo read Get;
      property    Count : integer read GetCount;
  end;//TSystemAgent
  
  
var
  SysAgent : TSystemAgent;
  
  
implementation
  
  
  constructor TSystemAgent.Create;
  begin
    inherited Create;
    FList := TList.Create;
    FSSH := '/usr/bin/ssh';
    Refresh;
  end;//TSystemAgent.Create
  //-------------------------
  destructor TSystemAgent.Destroy;
  var
    i : integer;
    OneInfo : TProcessInfo;
  begin
    for i:=0 to FList.Count-1 do begin
      OneInfo := TProcessInfo(FList.Items[i]);
      FreeAndNil(OneInfo);
    end;//for i
    FreeAndNil(FList);
    inherited Destroy;
  end;//TSystemAgent.Destroy
  //-------------------------
  function TSystemAgent.Get(Index: Integer) : TProcessInfo;
  begin
    Result := TProcessInfo(FList.Items[Index]);
  end;//TSystemAgent.Get
  //-------------------------
  function TSystemAgent.GetCount : integer;
  begin
    Result := FList.Count;
  end;//TSystemAgent.GetCount
  //-------------------------
  procedure TSystemAgent.Refresh;
  var
    Info : TSearchRec;
    i, n : integer;
    failed : boolean;
    OneInfo : TProcessInfo;
    FS : TFileStream;
    s, ss : string;
    ind : integer;
    found : boolean;
    User : string;
    Server : string;
    LPort : string;
    RPort : string;
  begin
    
    for i:=0 to FList.Count-1 do begin
      OneInfo := TProcessInfo(FList.Items[i]);
      FreeAndNil(OneInfo);
    end;//for i
    FList.Clear;
    
    if FindFirst('/proc/*', faDirectory, Info)=0 then begin
      repeat
        with Info do begin
          failed := false;
          for i:=1 to Length(Name) do begin
            if (Name[i]<'0') or (Name[i]>'9') then begin
              failed := true;
              break;
            end;
          end;//for i
          
          if not failed then begin
            try
              try
                FS := TFileStream.Create('/proc/'+Name+'/cmdline', fmOpenRead);
                SetLength(s, 1024);
                n := FS.Read(s[1], 1024);
                SetLength(s, n+1);
                s[n+1] := ' ';
                
                //change #0 to ' '
                for i:=1 to n do begin
                  if Ord(s[i])=0 then s[i] := ' ';
                end;//for i
                
                //check if this is a ssh
                ind := Pos(' ', s);
                ss := Copy(s, 1, ind);
                ind := Pos('/ssh ', ss);
                if (ss<>'ssh ') and (ind<=0) then continue;
                
                //check if this is a ssh tunnel
                if Pos(' -L ', s)<=0 then continue;
                
                //extract user name
                ind := Pos('@', s);
                if ind<=0 then continue;
                found := false;
                for i:=ind-1 downto 1 do begin
                  if s[i]=' ' then begin
                    found := true;
                    break;
                  end;
                end;
                if not found then continue;
                User := trim(Copy(s, i+1, ind-i-1));
                if User='' then User := GetEnvironmentVariable('USER');
                
                //extract server name/ip
                found := false;
                for i:=ind+1 to length(s) do begin
                  if (s[i]=' ')  then begin
                    found := true;
                    break;
                  end;
                end;
                if not found then continue;
                Server := trim(Copy(s, ind+1, i));
                
                //extract local port
                ind := Pos(':', s);
                if ind<=0 then continue;
                found := false;
                for i:=ind-1 downto 1 do begin
                  if s[i]=' ' then begin
                    found := true;
                    break;
                  end;
                end;
                if not found then continue;
                LPort := trim(Copy(s, i+1, ind-i-1));
                
                //extract remote port
                for i:=ind+1 to length(s) do begin
                  if s[i]=':' then begin
                    found := true;
                    ind := i;
                    break;
                  end;
                end;
                if not found then continue;
                found := false;
                for i:=ind+1 to length(s) do begin
                  if (s[i]=' ')  then begin
                    found := true;
                    break;
                  end;
                end;
                if not found then continue;
                RPort := trim(Copy(s, ind+1, i-ind-1));
                
                //create a process info
                OneInfo := TProcessInfo.Create(User, Server, '', StrToInt(RPort), StrToInt(LPort));
                OneInfo.PID := StrToInt(Name);
                FList.Add(OneInfo);
              except
                on e : Exception do begin
                  writeln('Error, ', e.Message);
                end else begin
                  writeln('Error, UNKOWN Error!');
                end;
              end;//try-except
            finally
              if Assigned(FS) then FreeAndNil(FS);
            end;
          end;
        end;
      until FindNext(Info)<>0;
    end;
    FindClose(Info);
  end;//TSystemAgent.Refresh
  //-------------------------
  procedure TSystemAgent.CreateTunnel(const TheInfo : TProcessInfo);
  begin
    ExecuteProcess(FSSH, ' -2 -N -f -L '+IntToStr(TheInfo.LPort)+':localhost:'+IntToStr(TheInfo.RPort)+' '+TheInfo.User+'@'+TheInfo.Server);
  end;//TSystemAgent.CreateTunnel
  //-------------------------
  procedure TSystemAgent.RemoveTunnel(const TheInfo : TProcessInfo);
  begin
    FpKill(TheInfo.PID, 9);
  end;//TSystemAgent.RemoveTunnel
  
  
initialization
  SysAgent := TSystemAgent.Create;
  
  
finalization
  if Assigned(SysAgent) then FreeAndNil(SysAgent);
  
  
end.//unit sshprocs

